home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 11 / Amoszine 11 (Disk 2 of 2).adf / Ben_Wyatt_Source.lha / Funnyizer.AMOS / Funnyizer.amosSourceCode
AMOS Source Code  |  2004-04-12  |  2KB  |  79 lines

  1. ' Funnyizer
  2. ' ~~~~~~~~~
  3. ' by Ben Wyatt, bwyatt@paston.co.uk
  4. '
  5. ' Can create funny words out of totally boring ones. Honest! 
  6.  
  7. Screen Open 0,640,256+56*Ntsc,2,Hires
  8. Screen Display 0,128,37,640,256+56*Ntsc
  9. Palette $0,$FFF
  10.  
  11. Dim NORM$(6),ABNORM$(18)
  12. Global NORM$(),ABNORM$()
  13. For N=1 To 18
  14.    Read ABNORM$(N)
  15. Next N
  16. For N=1 To 6
  17.    Read NORM$(N)
  18. Next N
  19. Data "B","C","D","F","G","H","J","K","L","M"
  20. Data "N","P","R","S","T","V","W","Z"
  21. Data "A","E","I","O","U","Y"
  22.  
  23. Print "Funnyizer"
  24. Print "~~~~~~~~~"
  25. Print "Type in a normal English word and I'll funnyize it"
  26. Print "Input nothing for the last word typed in"
  27. Print "Ctrl C to Quit"
  28. Print 
  29.  
  30. Repeat 
  31.    Input "A Normal Word:";B$
  32.    If B$<>""
  33.       A$=B$
  34.    Else 
  35.       Cup : Print "A Normal Word:";A$
  36.    End If 
  37.    _FUNNYIZE[A$]
  38.    If A$<>"" Then Print "    Funnyized:";Param$
  39.    Print 
  40. Until 0=1
  41. End 
  42.  
  43. Procedure _FUNNYIZE[A$]
  44.  
  45.    ' Funnyize A$ and return the new version in Param$ 
  46.  
  47.    A$=Upper$(A$)
  48.  
  49.    If Len(A$)<2
  50.       ' Too short
  51.       Print "Sorry, But I Prefer Longer Words" : A$=""
  52.  
  53.    Else 
  54.       C$=A$
  55.  
  56.       Repeat 
  57.          For N=2 To Len(A$)
  58.             If Rnd(1)=1 and Mid$(A$,N,1)<>" "
  59.                ' Get single character 
  60.                M$=Mid$(A$,N,1)
  61.                ' See if it matches any of the letters 
  62.                For M=1 To 6
  63.                   If NORM$(M)=M$ : B$=NORM$(Rnd(5)+1) : End If 
  64.                Next M
  65.                For M=1 To 18
  66.                   If ABNORM$(M)=M$ : B$=ABNORM$(Rnd(17)+1) : End If 
  67.                Next M
  68.                ' Change letter to new one 
  69.                Mid$(A$,N,1)=B$
  70.             End If 
  71.          Next N
  72.       Until C$<>A$
  73.  
  74.       ' Put first character in upper case and the rest in lower
  75.       A$=Upper$(Left$(A$,1))+Lower$(Right$(A$,Len(A$)-1))
  76.  
  77.    End If 
  78.  
  79. End Proc[A$]